home *** CD-ROM | disk | FTP | other *** search
/ Aminet 5 / Aminet 5 - March 1995.iso / Aminet / gfx / show / PlayKiSS0_88.lha / PlayKiss / src / kcftomap.e < prev    next >
Text File  |  1994-10-30  |  2KB  |  73 lines
  1.  
  2. MODULE 'dos/dos'
  3.  
  4. DEF rdarg
  5. DEF argarray[11]:LIST
  6. DEF source[150]:STRING
  7. DEF dest[150]:STRING
  8. DEF dummy[250]:STRING
  9. DEF fh1,fh2,res,i
  10. DEF red,grn,blu
  11. DEF buffer
  12.  
  13. PROC main() HANDLE
  14.     buffer:=New(1000)
  15.     argarray[0]:=0
  16.     argarray[1]:=0
  17.     rdarg:=ReadArgs('FROM/A,TO',argarray,0)
  18.  
  19.     IF argarray[0]<>NIL
  20.         StrCopy(source,argarray[0],ALL)
  21.     ENDIF
  22.     IF argarray[1]<>NIL
  23.         StrCopy(dest,argarray[1],ALL)
  24.         IF StrLen(dest)<1
  25.             StrCopy(dest,source,ALL)
  26.             i:=InStr(UpperStr(dest),'.KCF')
  27.             StrCopy(dest,source,i)
  28.             StrAdd(dest,'.map',ALL)
  29.         ENDIF
  30.     ENDIF
  31.  
  32. WriteF('Translating "\s" to "\s"...\n',source,dest)
  33.  
  34.     IF rdarg>0
  35.         IF (fh1:=Open(source,MODE_OLDFILE))
  36.             IF (fh2:=Open(dest,MODE_NEWFILE))
  37.                 PutLong(buffer,$50360A31)       -> P6 nl 1
  38.                 PutLong(buffer+4,$3620310A)     -> 6 space 1 nl
  39.                 PutLong(buffer+8,$3235350A)     -> 255 nl
  40.                 res:=Write(fh2,buffer,12)
  41.                 IF res<0 THEN Raise("DOS")
  42.                 FOR i:=0 TO 15
  43.                     res:=Read(fh1,buffer,2)
  44.                     IF res<0 THEN Raise("DOS")
  45.  
  46.                     red:=Shl((Shr(Char(buffer),4) AND %00001111),4)
  47.                     blu:=Shl((Char(buffer) AND %00001111),4)
  48.                     grn:=Shl((Char(buffer+1) AND %00001111),4)
  49.  
  50.                     PutChar(buffer,red)
  51.                     PutChar(buffer+1,grn)
  52.                     PutChar(buffer+2,blu)
  53.  
  54.                     res:=Write(fh2,buffer,3)
  55.                     IF res<0 THEN Raise("DOS")
  56.                 ENDFOR
  57.             ELSE
  58.                 Raise("DOS")
  59.             ENDIF
  60.         ELSE
  61.             Raise("DOS")
  62.         ENDIF
  63.     ELSE
  64.         Raise("DOS")
  65.     ENDIF
  66. EXCEPT DO
  67.     WriteF('\n\h \h \n\n',fh1,fh2)
  68.     IF fh1 THEN Close(fh1)
  69.     IF fh2 THEN Close(fh2)
  70.     IF buffer THEN Dispose(buffer)
  71.     IF exception THEN WriteF('An error occured.\n\n')
  72. ENDPROC
  73.